home *** CD-ROM | disk | FTP | other *** search
/ Shareware Grab Bag / Shareware Grab Bag.iso / 007 / qbtools1.arc / AEBITCLS.BAS next >
BASIC Source File  |  1987-01-11  |  640b  |  25 lines

  1. rem $linesize:132
  2. rem $title:'Application Engineer Statndard Routines'
  3. rem $subtitle:'Close an index'
  4. '                Include the COMMON values
  5. rem $include:'AESHARED.BAS'            
  6.     
  7. sub bit.close(fl%) static
  8.  
  9. '  close index file, open the header, read info
  10. '  update data, write info and close the header
  11.  
  12.         close #fl%
  13.         open "r",fl%,idx.nam$(fl%)+".hdr",512
  14.         field #fl%,32 as desc$,32 as xmast$,2 as klen$,2 as nok$,2 as nexav$
  15.         field #fl%,70 as twit$,2 as kdel$,440 as spare$
  16.         get #fl%,1
  17.         lset nok$=mki$(xh%(fl%,2))
  18.         lset nexav$=mki$(xh%(fl%,3))
  19.         lset kdel$=mki$(xh%(fl%,4))
  20.         put #fl%,1
  21.         close #fl%
  22.  
  23.     end sub
  24.  
  25.